BEGIN "NTONIC"
REQUIRE "DDHDR.SAI[GRA,HPM]" SOURCE_FILE;
REQUIRE "PRANDR.SAI[BIG,HPM]" SOURCE_FILE;
DEFINE NEL=99, N=3, NOPEN=27;
INTEGER DONE,FOO,I,J,K,L;
STRING S; BOOLEAN MERGE,PASS;
INTEGER ARRAY WIRE[0:N-1,0:NEL-1],STATE[0:N-1,0:NEL-1],NSET[0:NEL-1];
INTEGER ARRAY NEXT,PERM,OUTPUT,INPUTMAP1,INPUTMAP[0:N*NOPEN-1];

PROCEDURE FOLLOW;
   BEGIN
   INTEGER I,J,K,L;
   DONE←0;
   WHILE DONE<NEL DO FOR I←0 STEP 1 UNTIL NEL-1 DO IF NSET[I]=N THEN
      BEGIN
      FOR J←1 STEP 1 UNTIL N-1 DO FOR K←0 STEP 1 UNTIL J-1 DO
         IF STATE[J,I]<STATE[K,I] THEN STATE[J,I]↔STATE[K,I];
      FOR J←0 STEP 1 UNTIL N-1 DO
         BEGIN
         K←WIRE[J,I];
         IF K≥0 THEN
            BEGIN
            L←NSET[K];
            NSET[K]←L+1;
            STATE[L,K]←STATE[J,I];
            END
         ELSE
            OUTPUT[-1-K]←STATE[J,I];
         END;
      NSET[I]←-N;
      DONE←DONE+1;
      END;
   END;

PROCEDURE DRAW;
   BEGIN
   REAL ARRAY X,Y[0:NEL-1];
   INTEGER I,J,K,L;
   PROCEDURE SET(INTEGER L; REAL XV,YV);
      BEGIN X[L]←XV; Y[L]←YV; END;

   FOR L←0 STEP 1 UNTIL 2 DO
      BEGIN
      FOR I←0 STEP 1 UNTIL 2 DO
         BEGIN
         SET(L*33+I*6+0,1,1+I*3+L*10);
         SET(L*33+I*6+1,1,2+I*3+L*10);
         SET(L*33+I*6+2,1,3+I*3+L*10);
         SET(L*33+I*6+3,2,2+I*3+L*10);
         SET(L*33+I*6+4,3,1.2+I*3+L*10);
         SET(L*33+I*6+5,3,2.8+I*3+L*10);
         END;
      FOR I←2 STEP 1 UNTIL 8 DO SET(L*33+I+16,5,I+L*10);
      FOR I←1 STEP 1 UNTIL 8 DO SET(L*33+I+24,6,I+.5+L*10);
      END;

   DDINIT;
   SCREEN(-2,-1,9,31); COMMENT SCREEN(1.3,-1,9,11);
   DRKEN; RECTAN(-100,-100,100,100); LITEN;
   FOR I←0 STEP 1 UNTIL NEL-1 DO RECTAN(X[I]-.1,Y[I]-.2,X[I]+.2,Y[I]+.2);
   FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
      LINE(-1,I*10/26,X[INPUTMAP[I]],Y[INPUTMAP[I]]);
   FOR I←0 STEP 1 UNTIL NEL-1 DO
   FOR J←0 STEP 1 UNTIL N-1 DO
      BEGIN REAL FX,FY;
      FX←X[I]+.2; FY←Y[I]-.2+J*.2;
      IF WIRE[J,I]<0 THEN LINE(FX,FY,7,(-1-WIRE[J,I])*10/26)
         ELSE LINE(FX,FY,X[WIRE[J,I]],Y[WIRE[J,I]]);
      END;
   FOR I←1,2,3 DO DPYUP('36);  PJUP; PJUP;
   SHOW('36);
   END;
PROCEDURE M9WAY(INTEGER FIRST; INTEGER ARRAY NEXT1);
   BEGIN
   INTEGER ARRAY NEXT[0:8];
   PROCEDURE M3WAY(INTEGER FIRST; INTEGER ARRAY NEXT);
      BEGIN
      WIRE[0,0+FIRST]←NEXT[0];
      WIRE [1,0+FIRST]←4+FIRST;
      WIRE[2,0+FIRST]←3+FIRST;
      WIRE[0,1+FIRST]←4+FIRST;
      WIRE[1,1+FIRST]←3+FIRST;
      WIRE[2,1+FIRST]←5+FIRST;
      WIRE[0,2+FIRST]←3+FIRST;
      WIRE[1,2+FIRST]←5+FIRST;
      WIRE[2,2+FIRST]←NEXT[8];
      WIRE[0,3+FIRST]←4+FIRST;
      WIRE[1,3+FIRST]←NEXT[4];
      WIRE[2,3+FIRST]←5+FIRST;
      WIRE[0,4+FIRST]←NEXT[1];
      WIRE[1,4+FIRST]←NEXT[2];
      WIRE[2,4+FIRST]←NEXT[3];
      WIRE[0,5+FIRST]←NEXT[5];
      WIRE[1,5+FIRST]←NEXT[6];
      WIRE[2,5+FIRST]←NEXT[7];
      END;

   NEXT[0]←NEXT1[0];
   NEXT[1]←FIRST+25;
   FOR I←2 STEP 1 UNTIL 8 DO NEXT[I]←FIRST+16+I;
   M3WAY(6*0+FIRST,NEXT);
   NEXT[0]←FIRST+25;
   NEXT[8]←FIRST+32;
   FOR I←1 STEP 1 UNTIL 7 DO NEXT[I]←FIRST+17+I;
   M3WAY(6*1+FIRST,NEXT);
   FOR I←0 STEP 1 UNTIL 6 DO NEXT[I]←FIRST+18+I;
   NEXT[7]←FIRST+32;
   NEXT[8]←NEXT1[26];
   M3WAY(6*2+FIRST,NEXT);
   FOR I←1 STEP 1 UNTIL 3 DO
      BEGIN
      WIRE[0,FIRST+21-I]←FIRST+28-I;
      WIRE[1,FIRST+21-I]←WIRE[2,FIRST+21-I]←FIRST+29-I;
      WIRE[2,FIRST+21+I]←FIRST+29+I;
      WIRE[1,FIRST+21+I]←WIRE[0,FIRST+21+I]←FIRST+28+I;
      END;
   FOR I←1 STEP 1 UNTIL 4 DO
      BEGIN
      WIRE[0,FIRST+29-I]←NEXT1[-3*I+13];
      WIRE[1,FIRST+29-I]←NEXT1[-3*I+14];
      WIRE[2,FIRST+29-I]←NEXT1[-3*I+15];
      WIRE[0,FIRST+28+I]←NEXT1[3*I+11];
      WIRE[1,FIRST+28+I]←NEXT1[3*I+12];
      WIRE[2,FIRST+28+I]←NEXT1[3*I+13];
      END;

   WIRE[0,FIRST+21]←FIRST+28; WIRE[1,FIRST+21]←NEXT1[13]; WIRE[2,FIRST+21]←FIRST+29;
   END;

FOR J←0 STEP 1 UNTIL 2 DO
   BEGIN
   FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO NEXT[I]←-I-1-27*J;
   M9WAY(33*J,NEXT);
   END;

FOR K←0 STEP 1 UNTIL 2 DO
   BEGIN
   FOR I←0 STEP 1 UNTIL 2 DO FOR J←0 STEP 1 UNTIL 8 DO
      INPUTMAP[K*27+I*9+J]←I*6+(J MOD 3)+K*33;
   FOR I←0 STEP 1 UNTIL 26 DO
      INPUTMAP1[K*27+I]←INPUTMAP[K*27+I%3+(I MOD 3)*9];
   END;

FOR I←0 STEP 1 UNTIL 80 DO INPUTMAP[I]←INPUTMAP1[I%3+(I MOD 3)*27];

DRAW;

   BEGIN
   INTEGER ARRAY CNTR[1:N*NOPEN];
   INTEGER ARRAY CHECK[0:N*NOPEN,0:N*NOPEN];
   FOR I←1 STEP 1 UNTIL N*NOPEN DO CNTR[I]←(N*NOPEN-I)%NOPEN;
   MERGE←TRUE;
   DO
      BEGIN
      K←-1;
      FOR I←N-1 STEP -1 UNTIL 0 DO FOR J←1 STEP 1 UNTIL N*NOPEN DO
         IF CNTR[J]=I THEN PERM[K←K+1]←J;
      FOR I←0 STEP 1 UNTIL NEL-1 DO NSET[I]←0;
      FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
         BEGIN
         K←INPUTMAP[I];
         L←NSET[K];
         NSET[K]←L+1;
         STATE[L,K]←PERM[I];
         END;
      FOLLOW;
      PASS←FALSE;
      FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
         BEGIN
         L←0; WHILE CHECK[K,L]≠0∧CHECK[K,L]<OUTPUT[K] DO L←L+1;
         IF CHECK[K,L]≠OUTPUT[K] THEN
            BEGIN
            WHILE OUTPUT[K]≠0 DO
               BEGIN
               CHECK[K,L]↔OUTPUT[K];
               L←L+1;
               END;
            PASS←TRUE;
            END;
         END;
      IF PASS THEN
         BEGIN
         SETFORMAT(3,0);
         DRKEN; RECTAN(7.01,-100,100,100); LITEN;
         FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
            BEGIN
            TXTPOS(7.01,(N*NOPEN-1-K-.5)*10/26+.2,.1,.2);
            L←0; WHILE CHECK[K,L]≠0 DO TEXT(CVS(CHECK[K,(L←L+1)-1]));
            END;
         DPYUP('36);
         END;
      PWITHR(CNTR,N*NOPEN,MERGE);
      END UNTIL MERGE;
   END;

END;